home *** CD-ROM | disk | FTP | other *** search
/ Aminet 4 / Aminet 4 - November 1994.iso / aminet / dev / obero / oberon_lib.lha / oberon-a / source1.lha / source / Library / Strings.mod < prev    next >
Text File  |  1994-08-08  |  13KB  |  465 lines
  1. (***************************************************************************
  2.  
  3.      $RCSfile: Strings.mod $
  4.   Description: String manipulation
  5.  
  6.    Created by: fjc (Frank Copeland)
  7.     $Revision: 1.5 $
  8.       $Author: fjc $
  9.         $Date: 1994/08/08 16:25:47 $
  10.  
  11.   Copyright © 1994, Frank Copeland.
  12.   This file is part of the Oberon-A Library.
  13.   See Oberon-A.doc for conditions of use and distribution.
  14.  
  15. ***************************************************************************)
  16.  
  17. MODULE Strings;
  18.  
  19. (*
  20. ** $C= CaseChk       $I- IndexChk  $L+ LongAdr   $N= NilChk
  21. ** $P= PortableCode  $R= RangeChk  $S= StackChk  $T= TypeChk
  22. ** $V= OvflChk       $Z= ZeroVars
  23. **
  24. ** Index checking is handled explicitly by the relevant procedures.
  25. *)
  26.  
  27. IMPORT Util, SYS := SYSTEM;
  28.  
  29. CONST
  30.   DIGITS = "0123456789ABCDEF";
  31.  
  32. VAR
  33.   digits : ARRAY 17 OF CHAR;
  34.  
  35. (*------------------------------------*)
  36. (* $D- disable copying of open arrays *)
  37. PROCEDURE Length *
  38.   ( string : ARRAY OF CHAR ) : LONGINT;
  39. (*
  40.   Safely calculates the length of a string.
  41.  
  42.   This implementation checks the length of the string against the size of
  43.   the array before returning. This is necessary to deal with over-running
  44.   the end of the array if there is no NUL character (this happens when the
  45.   string exactly fills the array). This does not prevent the procedure from
  46.   merrily searching through memory well past the end of the array; it simply
  47.   ensures that whatever result is returned is sensible.
  48. *)
  49.  
  50. VAR length : LONGINT;
  51.  
  52. BEGIN (* Length *)
  53.   length := SYS.STRLEN (string);
  54.   IF length > LEN (string) THEN RETURN LEN (string) ELSE RETURN length END
  55. END Length;
  56.  
  57.  
  58. (*------------------------------------*)
  59. (* $D- disable copying of open arrays *)
  60. PROCEDURE Append *
  61.   ( VAR target : ARRAY OF CHAR; source : ARRAY OF CHAR );
  62. (*
  63.   Appends the source string to the target string, truncating if necessary.
  64. *)
  65.  
  66. VAR
  67.   maxLength, targetLength, newLength : LONGINT;
  68.  
  69. BEGIN (* Append *)
  70.   targetLength := Length (target);
  71.   maxLength := LEN (target); DEC (maxLength);
  72.   IF targetLength < maxLength THEN
  73.     (* There is actually room at the end of the array. *)
  74.     newLength :=
  75.       Util.MinLongint( targetLength + Length (source), maxLength);
  76.     SYS.MOVE
  77.       ( SYS.ADR (source), SYS.ADR (target [targetLength]),
  78.         newLength - targetLength );
  79.     target [newLength] := 0X;
  80.   END; (* IF *)
  81. END Append;
  82.  
  83.  
  84. (*------------------------------------*)
  85. (* $D- disable copying of open arrays *)
  86. PROCEDURE Insert *
  87.   ( VAR target : ARRAY OF CHAR;
  88.     subString  : ARRAY OF CHAR;
  89.     position   : LONGINT );
  90. (*
  91.   Insert "subString" into "target" starting at "position", truncating if
  92.   necessary.
  93. *)
  94.  
  95. VAR maxLength, subStringLength, targetLength : LONGINT;
  96.  
  97. BEGIN (* Insert *)
  98.   subStringLength := Length (subString);
  99.   targetLength := Length (target);
  100.   maxLength := LEN (target); DEC (maxLength);
  101.   IF (position >= targetLength) THEN
  102.     (* The start position is past the end of the target string. *)
  103.     Append (target, subString);
  104.   ELSIF ((subStringLength + targetLength) <= maxLength) THEN
  105.     (*
  106.       The result will fit into the target string. Move characters towards
  107.       the end of the string to make room and copy the new characters into
  108.       the space.
  109.     *)
  110.     SYS.MOVE
  111.       ( SYS.ADR (target [position]),
  112.         SYS.ADR (target [position + subStringLength]),
  113.         targetLength - position );
  114.     SYS.MOVE
  115.       (SYS.ADR (subString), SYS.ADR (target [position]), subStringLength);
  116.     target [targetLength + subStringLength] := 0X;
  117.   ELSIF ((position + subStringLength) < maxLength) THEN
  118.     (*
  119.       The result will overflow the target string, but the subString will
  120.       fit. Move characters towards the end of the string to make room and
  121.       copy the new characters into the space.
  122.     *)
  123.     SYS.MOVE
  124.       ( SYS.ADR (target [position]),
  125.         SYS.ADR (target [position + subStringLength]),
  126.         maxLength - subStringLength - position );
  127.     SYS.MOVE
  128.       ( SYS.ADR (subString), SYS.ADR (target [position]),
  129.         subStringLength );
  130.     target [maxLength] := 0X;
  131.   ELSE
  132.     (*
  133.       The result will overflow the target string, and the subString is too
  134.       long to fit. Just discard the end of the target string and append
  135.       the new characters to it.
  136.     *)
  137.     target [position] := 0X;
  138.     Append (target, subString);
  139.   END; (* ELSE *)
  140. END Insert;
  141.  
  142.  
  143. (*------------------------------------*)
  144. (* $D- disable copying of open arrays *)
  145. PROCEDURE OverWrite *
  146.   ( VAR target : ARRAY OF CHAR;
  147.     source     : ARRAY OF CHAR;
  148.     start      : LONGINT );
  149. (*
  150.   Overwrites the contents of "target" with "source", starting at "start".
  151.   Truncates where necessary.
  152. *)
  153.  
  154. VAR sourceLength : LONGINT;
  155.  
  156. BEGIN (* OverWrite *)
  157.   sourceLength :=
  158.     Util.MinLongint (Length (source), Length (target) - start);
  159.   IF sourceLength > 0 THEN
  160.     SYS.MOVE (SYS.ADR (source), SYS.ADR (target [start]), sourceLength)
  161.   END; (* IF *)
  162. END OverWrite;
  163.  
  164.  
  165. (*------------------------------------*)
  166. (* $D- disable copying of open arrays *)
  167. PROCEDURE OverWriteSubString *
  168.   ( VAR target : ARRAY OF CHAR;
  169.     start      : LONGINT;
  170.     source     : ARRAY OF CHAR;
  171.     subStart,
  172.     subLength  : LONGINT );
  173. (*
  174.   Overwrites the contents of target [start ...] with source [subStart ..
  175.   (subStart + subLength - 1)]. Truncates or extends where necessary.
  176. *)
  177.  
  178. VAR sourceLength : LONGINT;
  179.  
  180. BEGIN (* OverWriteSubString *)
  181.   sourceLength :=
  182.     Util.MinLongint
  183.       ( Util.MinLongint (subLength, Length (source) - subStart),
  184.         Length (target) - start );
  185.   IF sourceLength > 0 THEN
  186.     SYS.MOVE (SYS.ADR (source), SYS.ADR (target [start]), sourceLength)
  187.   END; (* IF *)
  188. END OverWriteSubString;
  189.  
  190.  
  191. (*------------------------------------*)
  192. (* $D- disable copying of open arrays *)
  193. PROCEDURE CopySubString *
  194.   ( VAR target : ARRAY OF CHAR;
  195.     source     : ARRAY OF CHAR;
  196.     start,
  197.     length     : LONGINT );
  198. (*
  199.   Assigns a copy of a sub-string of "source" to "target". The sub-string
  200.   starts at "start" and is "length" characters long. If an invalid substring
  201.   is specified, the target is set to an empty string.
  202. *)
  203.  
  204. VAR sourceLength, targetLength : LONGINT;
  205.  
  206. BEGIN (* CopySubString *)
  207.   targetLength := 0;
  208.   IF length > 0 THEN
  209.     sourceLength := Length (source);
  210.     IF (start < sourceLength) THEN
  211.       targetLength :=
  212.         Util.MinLongint (
  213.           Util.MinLongint (length, LEN (target) - 1), sourceLength - start);
  214.       SYS.MOVE (SYS.ADR (source [start]), SYS.ADR (target), targetLength);
  215.     END; (* IF *)
  216.   END; (* IF *)
  217.   target [targetLength] := 0X;
  218. END CopySubString;
  219.  
  220.  
  221. (*------------------------------------*)
  222. PROCEDURE DeleteSubString *
  223.   ( VAR string    : ARRAY OF CHAR;
  224.     start, length : LONGINT );
  225. (*
  226.   Deletes the sub-string of "string" starting at "start" that is "length"
  227.   characters long.
  228. *)
  229.  
  230. VAR stringLength : LONGINT;
  231.  
  232. BEGIN (* DeleteSubString *)
  233.   IF length > 0 THEN
  234.     stringLength := Length (string);
  235.     IF start < stringLength THEN
  236.       IF (start + length) < stringLength THEN
  237.         (*
  238.           Move characters towards the front of the array into the space
  239.           deleted.
  240.         *)
  241.         SYS.MOVE
  242.           ( SYS.ADR (string [start + length]), SYS.ADR (string [start]),
  243.             stringLength - (start + length) );
  244.         string [stringLength - length] := 0X;
  245.       ELSE
  246.         (* Delete to the end of the string. *)
  247.         string [start] := 0X;
  248.       END; (* ELSE *)
  249.     END; (* IF *)
  250.   END; (* IF *)
  251. END DeleteSubString;
  252.  
  253.  
  254. (*------------------------------------*)
  255. PROCEDURE FindChar *
  256.   ( char       : CHAR;
  257.     VAR target : ARRAY OF CHAR;
  258.     start      : LONGINT )
  259.   : LONGINT;
  260. (*
  261.   Searches "target" for the first occurrence of "char", starting at "start"
  262.   and returns its position if found, otherwise it returns the length of the
  263.   string.
  264. *)
  265.  
  266. VAR limit, position : LONGINT;
  267.  
  268. BEGIN (* FindChar *)
  269.   position := start;
  270.   limit := Length (target);
  271.   WHILE (position < limit) & (target [position] # char) DO
  272.     INC(position);
  273.   END; (* WHILE *)
  274.   IF position = limit THEN RETURN -1 ELSE RETURN position END
  275. END FindChar;
  276.  
  277.  
  278. (*------------------------------------*)
  279. (* $D- disable copying of open arrays *)
  280. PROCEDURE CompareCAP *
  281.   ( string1, string2 : ARRAY OF CHAR )
  282.   : SHORTINT;
  283. (*
  284.   Returns the result of the lexical comparison of the two strings. Returns
  285.   -1 if (string1 < string2), 0 if (string1 = string2) and 1 if
  286.   (string1 > string2). The case of the strings is ignored.
  287. *)
  288.  
  289. VAR
  290.   length1, length2, index, limit : LONGINT;
  291.   result : SHORTINT; ch1, ch2 : CHAR;
  292.  
  293. BEGIN (* CompareCAP *)
  294.   length1 := Length (string1);
  295.   length2 := Length (string2);
  296.   limit := Util.MinLongint (length1, length2);
  297.   index := 0;
  298.   LOOP
  299.     IF (index = limit) THEN
  300.       IF (length1 < length2) THEN
  301.         result := -1;
  302.       ELSIF (length1 > length2) THEN
  303.         result := 1;
  304.       ELSE
  305.         result := 0;
  306.       END; (* ELSE *)
  307.       EXIT;
  308.     END; (* IF *)
  309.     ch1 := CAP (string1 [index]); ch2 := CAP (string2 [index]);
  310.     IF ch1 < ch2 THEN
  311.       result := -1;
  312.       EXIT;
  313.     ELSIF ch1 > ch2 THEN
  314.       result := 1;
  315.       EXIT;
  316.     END; (* IF *)
  317.     INC (index);
  318.   END; (* LOOP *)
  319.   RETURN result;
  320. END CompareCAP;
  321.  
  322.  
  323. (*------------------------------------*)
  324. PROCEDURE TrimLeft *
  325.   (VAR string : ARRAY OF CHAR; char : CHAR );
  326. (*
  327.   Deletes any instances of "char" from the start of "string".
  328. *)
  329.  
  330. VAR length : LONGINT;
  331.  
  332. BEGIN (* TrimLeft *)
  333.   length := 0;
  334.   WHILE (string [length] = char) DO
  335.     INC (length);
  336.   END; (* WHILE *)
  337.   IF length > 0 THEN DeleteSubString (string, 0, length) END
  338. END TrimLeft;
  339.  
  340.  
  341. (*------------------------------------*)
  342. PROCEDURE TrimRight *
  343.   ( VAR string : ARRAY OF CHAR; char : CHAR );
  344. (*
  345.   Deletes any instances of "char" from the end of "string".
  346. *)
  347.  
  348. VAR start : LONGINT;
  349.  
  350. BEGIN (* TrimRight *)
  351.   start := Length (string);
  352.   WHILE (string [start] = char) DO DEC (start) END;
  353.   string [start] := 0X;
  354. END TrimRight;
  355.  
  356.  
  357. (*------------------------------------*)
  358. PROCEDURE Fill *
  359.   ( VAR string : ARRAY OF CHAR;
  360.     char       : CHAR;
  361.     start, length : LONGINT );
  362. (*
  363.   Fills string with char, beginning at start character for length
  364.   characters.
  365. *)
  366.  
  367. VAR newLength : LONGINT;
  368.  
  369. BEGIN (* Fill *)
  370.   IF start < (LEN (string) - 1) THEN
  371.     length := Util.MinLongint (length, LEN (string) - start - 1);
  372.     newLength := Util.MaxLongint (Length (string), start + length);
  373.     WHILE length > 0 DO
  374.       string [start] := char; INC (start); DEC (length)
  375.     END; (* WHILE *)
  376.     string [newLength] := 0X;
  377.   END; (* IF *)
  378. END Fill;
  379.  
  380.  
  381. (*------------------------------------*)
  382. PROCEDURE ToUpper *
  383.   (VAR string : ARRAY OF CHAR);
  384.  
  385.   VAR index : LONGINT; ch : CHAR;
  386.  
  387. BEGIN (* ToUpper *)
  388.   index := 0; ch := string [0];
  389.   WHILE ch # 0X DO
  390.     string [index] := CAP (ch); INC (index); ch := string [index]
  391.   END; (* WHILE *)
  392. END ToUpper;
  393.  
  394.  
  395. (*------------------------------------*)
  396. PROCEDURE ToLower *
  397.   (VAR string : ARRAY OF CHAR);
  398.  
  399.   VAR index : LONGINT; ch : CHAR;
  400.  
  401. BEGIN (* ToLower *)
  402.   index := 0; ch := string [0];
  403.   WHILE ch # 0X DO
  404.     IF ((ch >= "A") & (ch <= "Z")) OR ((ch >= "À") & (ch <= "ß")) THEN
  405.       ch := CHR (ORD (ch) + 32); string [index] := ch
  406.     END; (* IF *)
  407.     INC (index); ch := string [index]
  408.   END; (* WHILE *)
  409. END ToLower;
  410.  
  411.  
  412. (*------------------------------------*)
  413. PROCEDURE IntToString *
  414.   ( int : LONGINT; base, field : INTEGER;
  415.     padChar : CHAR; VAR str : ARRAY OF CHAR );
  416.  
  417.   VAR i, j, k : INTEGER; temp : ARRAY 33 OF CHAR; neg : BOOLEAN;
  418.  
  419. BEGIN (* IntToString *)
  420.   IF (base < 2) OR (base > 16) THEN HALT (30) END;
  421.   i := 0; neg := (int < 0); int := ABS (int);
  422.   REPEAT
  423.     temp [i] := digits [SHORT (int MOD base)]; INC (i); int := int DIV base
  424.   UNTIL int = 0;
  425.   IF neg THEN temp [i] := "-"; INC (i) END;
  426.   j := i; k := 0;
  427.   WHILE j < field DO str [k] := padChar; INC (j); INC (k) END;
  428.   WHILE i > 0 DO DEC (i); str [k] := temp [i]; INC (k) END;
  429.   str [k] := 0X
  430. END IntToString;
  431.  
  432. (*------------------------------------*)
  433. (*$D-*)
  434. PROCEDURE StringToInt *
  435.   ( str : ARRAY OF CHAR; base : INTEGER; VAR int : LONGINT )
  436.   : BOOLEAN;
  437.  
  438.   VAR i, d, temp, limit : LONGINT; ch : CHAR; neg : BOOLEAN;
  439.  
  440. BEGIN (* StringToInt *)
  441.   IF (base < 2) OR (base > 16) THEN RETURN FALSE END;
  442.   limit := MAX (LONGINT) DIV base; i := 0; ch := str [i];
  443.   WHILE (ch # 0X) & (ch <= " ") DO INC (i); ch := str [i] END;
  444.   IF ch = "-" THEN neg := TRUE; INC (i); ch := str [i]
  445.   ELSE neg := FALSE
  446.   END;
  447.   temp := 0;
  448.   WHILE ch > " " DO
  449.     IF (ch >= "0") & (ch <= "9") THEN d := ORD (ch) - ORD ("0")
  450.     ELSIF (ch >= "A") & (ch <= "F") THEN d := ORD (ch) - (ORD ("A") - 10)
  451.     ELSE RETURN FALSE
  452.     END;
  453.     IF d >= base THEN RETURN FALSE END;
  454.     IF (limit - d) < temp THEN RETURN FALSE END;
  455.     temp := temp * base + d;
  456.     INC (i); ch := str [i]
  457.   END;
  458.   IF neg THEN int := -temp ELSE int := temp END;
  459.   RETURN TRUE
  460. END StringToInt;
  461.  
  462. BEGIN
  463.   digits := DIGITS
  464. END Strings.
  465.